perm filename ORDER.NEW[1,JRA] blob sn#005892 filedate 1972-09-14 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP RESOLVE1 
00400	 (LAMBDA(C D)
00500	  (PROG (CB DB DB1 YC YD YD1 Z X Y RES)
00600		(COND ((AND COND (EVAL COND)) (ERR (CDR LCL))))
00700		(SETQ YC (CDR C))
00800		(SETQ CB (POSBIT C))
00900		(SETQ YD1 (NEGL D))
01000		(SETQ DB1 (NEGBIT D))
01100		(SETQ DB DB1)
01200		(SETQ YD YD1)
01300	   RES1 (SETQ X (CAR YC))
01400		(COND ((NEG X) (RETURN RES)))
01500		(SETQ Y (CAR YD))
01600		(COND ((ORDERP (CAR X) (CADR Y)) (GO RES3)) ((NOT (EQ (CAR X) (CADR Y))) (GO RES4)))
01700	(COND((AND(EQ(CAR X) @LE)(MEMQ @R (PRDLET(CDR D))))(GO RES3A)))
01800		(SETQ YD1 YD)
01900		(SETQ DB1 DB)
02000		(GO RES2A)
02100	   RES2 (SETQ Y (CAR YD))
02200		(COND ((NOT (EQ (CAR X) (CADR Y))) (GO RES3A)))
02300	   RES2A
02400		(COND ((NOT (UNIFAB (CAR CB) (CAR DB))) (GO RES2B)))
02500		(SETQ Z (UNIFY (CDR X) (CDDR Y)))
02600		(COND ((NULL Z) (GO RES2B)))
02700		(SETQ PARRES NIL)
02800		(SETQ Z (UNION (CDR Z) C D X Y))
02900		(COND ((NULL Z) (GO RES2B)) ((NULL (CAR Z)) (RETURN Z)))
03000		(SETQ RES (CONS (SET2 (CAR (COND (DLIST (DEMOD Z DLIST)) (T Z))) TBL) RES))
03100	   RES2B
03200		(SETQ YD (CDR YD))
03300		(COND (YD (SETQ DB (CDR DB)) (GO RES2)))
03400	   RES3A
03500		(SETQ DB DB1)
03600		(SETQ YD YD1)
03700	   RES3 (SETQ YC (CDR YC))
03800		(COND (YC (SETQ CB (CDR CB)) (GO RES1)))
03900		(RETURN RES)
04000	   RES4 (SETQ YD (CDR YD))
04100		(COND (YD (SETQ DB (CDR DB)) (GO RES1)))
04200		(GO RES3A))) 
04300	EXPR)
04400	
04500	(DEFPROP PARMOD1 
04600	 (LAMBDA(C D)
04700	  (PROG (YC YD Z Z1 Z2 X Y Y1 Y2 PAR TS)
04800		(COND ((EQ C D) (RETURN NIL)))
04900		(SETQ YC (CDR C))
05000	   PAR1 (SETQ YD (CDR D))
05100		(SETQ X (CAR YC))
05200		(COND ((NEG X) (RETURN PAR))
05300		      ((ORDERP (CAR X) EQUAL) (GO PAR2))
05400		      ((NOT (EQ (CAR X) EQUAL)) (RETURN PAR)))
05500	   PAR3 (COND ((EQUAL (CADR X) (CADDR X)) (GO PAR2)))
05700	   PAR3A
05800		(COND ((NEG (CAR YD)) (SETQ Z2 (CDAR YD))) (T (SETQ Z2 (CAR YD))))
05900		(SETQ Y1 (CDR X))
06000		(COND ((VAR (CAR Y1)) (GO PAR7A)))
06100		(SETQ Y2 (CADR Y1))
06200		(SETQ Z (TERMS (CAAR Y1) (CDR Z2) PDEPTH))
06300		(COND ((NULL Z) (GO PAR7A)))
06400	   PAR5 (SETQ Z1 Z)
06500	   PAR4 (SETQ Y (UNIFY (LIST (CAR Y1)) (LIST (CAAR Z1))))
06600		(COND (Y (GO PAR6)))
06700	   PAR7 (SETQ Z1 (CDR Z1))
06800		(COND (Z1 (GO PAR4)))
06900	   PAR7A
07000		(SETQ YD (CDR YD))
07100		(COND (YD (GO PAR3A)))
07200	   PAR2 (SETQ YC (CDR YC))
07300		(COND (YC (GO PAR1)))
07400		(RETURN PAR)
07500	   PAR6 (SETQ TS (CADR (SUBS3T* (CDR Y) (LIST NIL Y2))))
07600	   PAR9 (SETQ PARRES (SUBS3TA (CDR Y) Z2 (CAR Z1) TS))
07700		(COND ((NEG (CAR YD)) (SETQ PARRES (CONS ESCAPE PARRES))))
07800		(SETQ Y (UNION (CDR Y) C D X (CAR YD)))
07900		(COND ((NULL Y) (GO PAR7)))
08000		(SETQ PAR (CONS (SET2 (CAR (COND (DLIST (DEMOD Y DLIST)) (T Y))) TBL) PAR))
08100		(GO PAR7))) 
08200	EXPR)
08300	(DE PRDLET(C)
08400	(PROG(Z)
08500	A(COND((NEG(CAR C))(SETQ Z(CONS(CADAR C) Z)))
08600	    (T(SETQ Z(CONS(CAAR C) Z))))
08700	(SETQ C(CDR C))
08800	(COND(C(GO A)))(RETURN Z)))
08900